! module ttt_board

module ttt_board
    use players
    use pieces
	use positions
    implicit none
    private
! public data
    integer, public, parameter:: move_command = 1
    integer, public, parameter:: quit_command = 2
    integer, public, parameter:: undo_command = 3
    type(player), public, target:: mrx, mro, mrcat
    type(piece), public:: an_x, an_o
! public methods
    public board_module_initialize, board_module_finalize
    public player, board, move_spec, piece
	public legal_move, is_winner, open_positions, opponent
    public new, destroy, move, winner, as_string, mover, incomplete
    public assignment(=), operator(==)

! types
    type move_spec
        integer code 
        integer x, y
        type(piece) p
    end type move_spec

    integer, parameter:: n = 3, m = 3, nwins = 3
    type board
        type(position):: spaces(n, m)
        type(player), pointer:: winner
        type(player), pointer:: to_move
		integer:: open_positions
    end type board
! interfaces

    interface new
        module procedure board_create
    end interface

    interface destroy
        module procedure board_destroy
    end interface

    interface move
       module procedure board_move
    end interface

    interface winner
        module procedure board_winner
    end interface

    interface mover
        module procedure board_mover
    end interface

    interface as_string
        module procedure board_as_string
    end interface

	interface incomplete
		module procedure board_incomplete
	end interface

	interface open_positions
		module procedure board_open_positions
	end interface

    interface assignment(=)
        module procedure board_assign
    end interface

    interface operator(==)
        module procedure move_equals
    end interface

contains

    subroutine board_module_initialize ()
	integer n
    call new(mrx, "X")
    call new(mro, "O")
    call new(mrcat, "C")
    call new(an_x, "X")
    call new(an_o, "O")
	n = give(mrx, an_x)
	n = give(mro, an_o)
    end subroutine board_module_initialize

    subroutine board_module_finalize ()
	call destroy(mrx)
	call destroy(mro)
	call destroy(mrcat)
    end subroutine board_module_finalize


    function move_equals(p1, p2) result(b)
    logical b
    type(move_spec), intent(in):: p1, p2
    b = (p1%x == p2%x) .and. (p1%y == p2%y)
    end function move_equals

    function board_as_string (b) result(s)
    type(board), intent(in):: b
    character s(n, m)
    integer i,j
    forall(i=1:n, j=1:m) s(i,j) = as_string(b%spaces(i,j))     
    end function board_as_string

    subroutine board_create (b) 
    type(board), intent(inout):: b
    integer i,j
	b%winner => mrcat
	b%to_move => mrx
	b%open_positions = n * m
    do i = 1, n
		do j = 1, m
			call clear(b%spaces(i,j))
		enddo
	enddo     
    end subroutine board_create

    subroutine board_destroy (b)
    type(board), intent(in):: b
    end subroutine board_destroy

    function board_incomplete (b) result(s)
    type(board), intent(in):: b
    logical s
    integer i,j
	s = .false.
	if(associated(b%winner, mrcat)) then
		s = (open_positions(b) > 0)
	endif
    end function board_incomplete

    function board_open_positions (b)
    type(board), intent(in):: b
    integer board_open_positions
    board_open_positions = b%open_positions
    end function board_open_positions

    function board_winner (b)
    type(board), intent(in):: b
    type(player),pointer:: board_winner
    board_winner => b%winner
    end function board_winner

    function board_mover (b)
    type(board), intent(in):: b
    type(player),pointer:: board_mover
    board_mover => b%to_move
    end function board_mover

    subroutine board_assign (b, c)
    type(board), intent(in):: c
    type(board), intent(out):: b
    b%spaces = c%spaces
    b%winner => c%winner
    b%to_move => c%to_move
	b%open_positions = c%open_positions
    end subroutine board_assign

    function board_move (b, m) result(moved)
    type(board), target, intent(inout):: b
    type(move_spec), intent(in):: m
    logical moved !status
    integer x, y
	type(piece) the_move
     
    moved = .false.
    x = m%x
    y = m%y
	the_move = m%p

    if(legal_move(b, the_move, x, y)) then
        b%spaces(x, y) = the_move
		b%open_positions = b%open_positions - 1
        if (is_winner(b, the_move, x, y)) then
            b%winner =>b%to_move
        endif
        b%to_move => opponent(b%to_move)
        moved = .true.
    endif

    end function board_move

    function legal_move(b, the_move, x, y)
    ! is x,y a legal move on b?
    type(board), intent(in):: b
    integer, intent(in):: x, y
	type(piece), intent(in):: the_move
    logical legal_move

    legal_move = (1 <= x .and. x <= n .and. &
                  1 <= y .and. y <= m)
    if (legal_move) then
        legal_move = is_empty(b%spaces(x,y))
    endif
    end function legal_move

    function is_winner(b, t, x, y) result(win)
    ! does the move on b at (x,y) by t win?
    ! assumes legal_move(b, t, x, y)
	! doesn't assume the move has been made, but ok if so.
    type(board), intent(in):: b
    type(piece):: t
    integer, intent(in):: x, y

    integer i, j, k
	integer i1, i2, j1, j2
    logical win

    win = .false.
	i1 = max(x - nwins + 1, 1)
	i2 = min(x + nwins - 1, n)
	j1 = max(y - nwins + 1, 1)
	j2 = min(y + nwins - 1, m)

	k = 0
	do i = i1, i2
		if(i == x) then
            k = k + 1
        elseif(is_empty(b%spaces(i, y))) then
            k = 0
        elseif (contents(b%spaces(i, y)) == t) then
			k = k + 1
		else
			k = 0
		endif
		if (k == nwins) then
			win = .true.
			return
		endif
	enddo
    
	k = 0
	do j = j1, j2
		if(j == y) then
            k = k + 1
        elseif(is_empty(b%spaces(x, j))) then
            k = 0
        elseif(contents(b%spaces(x, j)) == t) then
			k = k + 1
		else
			k = 0
		endif
		if (k == nwins) then
			win = .true.
			return
		endif
	enddo

! covariant diagonal
	k = 0
	do i = i1, i2
        j = y + x - i
        if(j < 1 .or. j > m) then
            k = 0
		elseif(i==x) then
            k = k + 1
        elseif(is_empty(b%spaces(i, j))) then
            k = 0
        elseif(contents(b%spaces(i, j)) == t) then
			k = k + 1
		else
			k = 0
		endif
		if (k == nwins) then
			win = .true.
			return
		endif
	enddo
    
! contravariant diagonal
	k = 0
	do i = i1, i2
        j = y - (x - i)
        if(j < 1 .or. j > m) then
            k = 0
		elseif(i == x) then
            k = k + 1
        elseif(is_empty(b%spaces(i,j))) then
            k = 0
        elseif(contents(b%spaces(i, j)) == t) then
			k = k + 1
		else
			k = 0
		endif
		if (k == nwins) then
			win = .true.
			return
		endif
	enddo
    end function is_winner

    function opponent(p)
    type(player), pointer:: p
    type(player), pointer:: opponent
    if(associated(p, mrx)) then
        opponent => mro
    else
        opponent => mrx
    endif
    end function opponent

end module ttt_board
